ADA Programming Guide

home *** CD-ROM | disk | FTP | other *** search

/ ADA Programming Guide / ADA Programming Guide.iso / adatutor / lrmrdr / lrm.a < prev next >

Wrap

Text File | 1996-01-30 | 61KB | 1,714 lines

--:::::::::: --copyrite.ada --:::::::::: -- *********************************************************************** -- ON-LINE Ada LANGUAGE REFERENCE MANUAL by Richard Conn -- -- COPYRIGHT NOTICE -- Ada LRM Reader - Interactive Presentation of the Ada LRM -- Copyright (C) 1992 Richard Conn -- -- This program is free software; you can redistribute it -- and/or modify it under the terms of the GNU General Public -- License Version 1 as published by the Free Software -- Foundation. -- -- This program is distributed in the hope that it will be -- useful, but WITHOUT ANY WARRANTY; without even the implied -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR -- PURPOSE. See the GNU General Public License for more -- details. You should have received a copy of the GNU General -- Public License along with this program; if not, write to the -- Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA -- 02139, USA. See the ABOUT screens for further information, -- including information on how to contact the author. --:::::::::: --command.ads --:::::::::: -- *********************************************************************** -- ON-LINE Ada LANGUAGE REFERENCE MANUAL by Richard Conn with Citation_Definition; package Command_Dispatcher is function Convert_Citation (CitS : in STRING) return Citation_Definition.CITATION_ID; -- Convert the indicated string ("n.n.n" or "keyword") to CITATION_ID procedure View_Help; -- View help citation and then Dispatch (Citation_Definition.USER_INPUT) procedure Dispatch (Current_Citation : in Citation_Definition.CITATION_ID); -- Dispatch Current_Citation as first command and continue with -- USER_INPUT until command is QUIT end Command_Dispatcher; --:::::::::: --display.ads --:::::::::: -- *********************************************************************** -- ON-LINE Ada LANGUAGE REFERENCE MANUAL by Richard Conn with SYSDEP; with Citation_Definition; with DAF_Handler; with System; -- standard Ada environment with Console; -- CS Parts package Screen_Display_Controller is type ERROR_MESSAGE_ID is (INVALID_COMMAND, CANNOT_ADVANCE, CANNOT_BACK, STACK_EMPTY, STACK_FULL, PRINT_LOG, TOO_MANY_SCREENS, SEARCH_STRING, DAF_NOT_FOUND, INTERNAL_DAF_NDFO_ERROR, INTERNAL_DAF_RE_ERROR, INTERNAL_DAF_SO_ERROR, INTERNAL_DAF_UE_ERROR, UNEXPECTED_ERROR); -- Kinds of error messages which may be displayed type SCREEN_BUFFER is array (NATURAL'(1)..SYSDEP.Text_Line_Count) of DAF_Handler.LINE; -- Lines associated with a screen type SCREEN_BUFFER_POINTER is access SCREEN_BUFFER; -- Pointer to a screen buffer so the full buffer does not have to be -- passed subtype LINE_NUMBER is NATURAL range NATURAL(Console.ROW_NUMBER'FIRST) .. NATURAL(Console.ROW_NUMBER'LAST); -- Valid line number from Console.ROW_NUMBER procedure Show_Text; -- Clear screen and display the text area procedure Mark_Line (Number : in LINE_NUMBER); -- Place a mark on the indicated line procedure Show_Prompt; -- Display prompt on command line; if Search_String is null, do not -- display it; clear error message if one is present after one call -- to Show_Prompt procedure Show_Error (Item : in ERROR_MESSAGE_ID); -- Display error message procedure Print_Log_File_Closed_Message; -- Print the message that the indicated print log file is closed function Convert (SB_Address : in System.ADDRESS) return SCREEN_BUFFER_POINTER; -- Given the address of a screen buffer object, return a pointer to it function Citation_to_Display (CitX : in Citation_Definition.CITATION_ID) return STRING; -- Given a citation ID, return a string of the form "n.n.n" or "keyword" end Screen_Display_Controller; --:::::::::: --pcit.ads --:::::::::: -- *********************************************************************** -- ON-LINE Ada LANGUAGE REFERENCE MANUAL by Richard Conn with SYSDEP; with Citation_Definition; with Screen_Display_Controller; package Primitive_Citation_Handler is subtype SEARCH_STRING is STRING (1..SYSDEP.Screen_String_Length); -- Statistics on current citation type CITATION_STATISTICS is record ID : Citation_Definition.CITATION_ID; Current_Screen_Number : NATURAL; Total_Number_of_Screens : NATURAL; Stack_Level : NATURAL; Search_Str : SEARCH_STRING; Search_Last : NATURAL; -- index of last char in Search_Str Search_May_Be_Continued : BOOLEAN; end record; -- Status of a search request type SEARCH_STATUS is record Is_Found : BOOLEAN; -- TRUE if string was found Found_on_Screen : NATURAL; -- if found, screen string was found on Found_on_Line : NATURAL; -- if found, line string was found on end record; -- Exceptions: SCREEN_COUNT_OVERFLOW : exception; -- raised if number of screens exceeds SYSDEP.Max_Number_of_Screens -- raised by Open_New_Citation function DAF_File_Name (ITEM : in Citation_Definition.CITATION_ID) return STRING; -- Return the name of the *.daf file associated with a given CITATION_ID procedure Open_New_Citation (ID : in Citation_Definition.CITATION_ID); -- Open a new citation for processing, closing the old one if -- necessary; set the current screen to the first screen; -- build an array of information on the screens function Push return BOOLEAN; -- Push the stack, returning TRUE if OK function Pop return BOOLEAN; -- Pop the stack, returning TRUE if OK -- Screen Buffer is loaded appropriately procedure Load_Screen_Buffer; -- Load the screen buffer with the current screen function Next_Screen return BOOLEAN; -- Advance to the next screen, returning TRUE if done; -- if at last screen of current citation, advance to the first screen -- of the next citation -- Screen Buffer is loaded appropriately function Previous_Screen return BOOLEAN; -- Back up to the previous screen, returning TRUE if done; -- if at first screen of current citation, back up to last screen -- of previous citation -- Screen Buffer is loaded appropriately function Next_Citation return BOOLEAN; -- Advance to the first screen of the next citation, returning TRUE -- if done Screen Buffer is loaded appropriately function Previous_Citation return BOOLEAN; -- Back up to the first screen of the previous citation, returning TRUE -- if done -- Screen Buffer is loaded appropriately function Search_First (Item : in STRING) return SEARCH_STATUS; -- Search for the Item from the beginning of the citation; -- if Item is an empty string, resume search for last item requested function Search_Next (Item : in STRING) return SEARCH_STATUS; -- Resume search for Item from the next line in the citation; -- if Item is an empty string, resume search for last item requested function Current_Citation return CITATION_STATISTICS; -- Return the statistics on the current citation procedure Close_All_Open_Citations; -- Close all open citation files procedure Suspend; -- Suspend operation for Print_Log procedure Resume; -- Resume operation for Print_Log function Access_Screen return Screen_Display_Controller.SCREEN_BUFFER_POINTER; -- Return the address of the screen for printing or displaying end Primitive_Citation_Handler; --:::::::::: --cithandl.ads --:::::::::: -- *********************************************************************** -- ON-LINE Ada LANGUAGE REFERENCE MANUAL by Richard Conn with Citation_Definition; package Citation_Handler is -- Abstract state machine for selecting and working with a given citation procedure View_Citation (New_Citation : in Citation_Definition.CITATION_ID); -- Start viewing a new citation, displaying the first screen procedure Redisplay_Current_Screen; -- Refresh current screen in current citation procedure Next_Screen; -- Advance to next screen in current citation and display procedure Previous_Screen; -- Back up to previous screen in current citation and display procedure Next_Citation; -- Close current citation and view first screen of next citation procedure Previous_Citation; -- Close current citation and view first screen of previous citation procedure Push (New_Citation : in Citation_Definition.CITATION_ID); -- Save position in current citation and -- start viewing a new citation, displaying the first screen procedure Pop; -- Return to current position in last citation before last PUSH procedure Search_for_First_Occurrence (Item : in STRING); -- Search for first occurrence of string in current citation procedure Search_for_Next_Occurrence (Item : in STRING); -- Search for next occurrence of string in current citation procedure Close_All_Open_Citations; -- Close all open citations end Citation_Handler; --:::::::::: --printlog.ads --:::::::::: -- *********************************************************************** -- ON-LINE Ada LANGUAGE REFERENCE MANUAL by Richard Conn package Print_Log_Handler is -- Abstract state machine for manipulating the Print Log File PRINT_LOG_CREATION_ERROR : exception; procedure Print_Current_Citation; -- Print current citation to log file procedure Print_Current_Screen; -- Print current screen to log file procedure Close_Print_Log; -- Close log file and display message to user end Print_Log_Handler; --:::::::::: --lrm.ada --:::::::::: -- *********************************************************************** -- ON-LINE Ada LANGUAGE REFERENCE MANUAL by Richard Conn with SYSDEP; with Citation_Definition; with Citation_Handler; with Command_Dispatcher; with Print_Log_Handler; with Screen_Display_Controller; with CLI; -- CS Parts with Console; -- CS Parts procedure LRM_Reader is use Citation_Definition; -- for equality tests First_Citation : Citation_Definition.CITATION_ID; Last_Citation_Allowed : constant Citation_Definition.CITATION_ID := Citation_Definition.HELP; begin -- LRM_Reader CLI.Initialize ("LRM", "LRM"); for I in SYSDEP.Intro_Copyright_Notice'RANGE loop Console.Put_Line (SYSDEP.Intro_Copyright_Notice(I)); end loop; delay 1.0; if CLI.Argc = 1 then Command_Dispatcher.View_Help; else First_Citation := Command_Dispatcher.Convert_Citation (CLI.Argv(1)); if First_Citation >= Citation_Definition.CITATION_ID'FIRST and First_Citation < Last_Citation_Allowed then Command_Dispatcher.Dispatch (First_Citation); else Command_Dispatcher.View_Help; end if; end if; Print_Log_Handler.Close_Print_Log; Citation_Handler.Close_All_Open_Citations; exception -- LRM_Reader when others => Screen_Display_Controller.Show_Error (Screen_Display_Controller.UNEXPECTED_ERROR); Print_Log_Handler.Close_Print_Log; end LRM_Reader; --:::::::::: --command.adb --:::::::::: -- *********************************************************************** -- ON-LINE Ada LANGUAGE REFERENCE MANUAL by Richard Conn with SYSDEP; with Citation_Handler; with DAF_Handler; with Primitive_Citation_Handler; with Print_Log_Handler; with Screen_Display_Controller; with Console; -- CS Parts package body Command_Dispatcher is use Citation_Definition; -- for infix operators only New_Command : STRING (1..SYSDEP.Max_String_Length); New_Command_Length : NATURAL; Citation_to_Process : Citation_Definition.CITATION_ID; --------------------------------------------------------------- -- Support Routines --------------------------------------------------------------- procedure Process_User_Input is -- Display prompt, get line from user, and process begin -- Process_User_Input -- init command's first five characters to spaces New_Command (1..5) := " "; -- 5 spaces -- input command Screen_Display_Controller.Show_Prompt; Console.Get_Line (New_Command, New_Command_Length); -- remove trailing spaces for I in reverse 1 .. New_Command_Length loop if New_Command(I) > ' ' then New_Command_Length := I; exit; end if; if I = 1 then New_Command_Length := 0; end if; end loop; -- if <CR> was typed, command is Next_Screen if New_Command_Length = 0 then Citation_Handler.Next_Screen; else -- figure out what command was -- check for search_first (/) and search_next (//) if New_Command(1) = '/' then if New_Command(2) = '/' then Citation_Handler.Search_for_Next_Occurrence (New_Command(3..New_Command_Length)); else Citation_Handler.Search_for_First_Occurrence (New_Command(2..New_Command_Length)); end if; -- check for PUSH elsif Convert_Citation(New_Command(1..4)) = Citation_Definition.PUSH then declare Start : NATURAL := New_Command_Length; begin for I in 5 .. New_Command_Length loop if New_Command(I) > ' ' then Start := I; exit; end if; end loop; Citation_Handler.Push (Convert_Citation(New_Command (Start..New_Command_Length))); end; -- handle all other commands as citations to return thru Dispatch else Citation_to_Process := Convert_Citation(New_Command(1..New_Command_Length)); end if; end if; end Process_User_Input; --------------------------------------------------------------- -- Exported Routines --------------------------------------------------------------- function Convert_Citation (CitS : in STRING) return Citation_Definition.CITATION_ID is use Citation_Definition; type PARSE_STATE is (IN_CHAPTER, IN_SECTION, TO_SECTION, IN_SUBSECTION, TO_SUBSECTION, IN_PARAGRAPH, TO_PARAGRAPH); CFirst_Index : NATURAL; CLast_Index : NATURAL; PFirst_Index : NATURAL; PLast_Index : NATURAL; SFirst_Index : NATURAL; SLast_Index : NATURAL; SSFirst_Index : NATURAL; SSLast_Index : NATURAL; CFound : BOOLEAN := FALSE; PFound : BOOLEAN := FALSE; SFound : BOOLEAN := FALSE; SSFound : BOOLEAN := FALSE; State : PARSE_STATE := IN_CHAPTER; Result : CITATION_ID; Cit_Str : STRING(1..20); Cit_Index : NATURAL; procedure Reset_Citation_String is begin Cit_Index := 0; end Reset_Citation_String; function String_to_Citation (Str : in STRING) return CITATION_ID is begin return CITATION_ID'VALUE (Str); exception when others => return ERROR; end String_to_Citation; procedure Append_to_Citation_String (Kind : in CHARACTER; Value : in STRING) is begin Cit_Index := Cit_Index + 1; Cit_Str(Cit_Index) := Kind; Cit_Index := Cit_Index + 1; Cit_Str(Cit_Index .. Cit_Index + Value'LENGTH - 1) := Value; Cit_Index := Cit_Index + Value'LENGTH - 1; end Append_to_Citation_String; begin -- Convert_Citation -- Check for empty CitS if CitS'LENGTH = 0 then return ERROR; end if; -- Check for special cases (HELP, CONTENTS, etc) Result := String_to_Citation(CitS); if Result /= ERROR then return Result; end if; -- Extract indices of chapter, section, subsection, and paragraph CFirst_Index := CitS'FIRST; CLast_Index := CitS'FIRST; for I in CitS'FIRST .. CitS'LAST loop if CitS(I) in '0' .. '9' or CitS(I) in 'A' .. 'Z' or CitS(I) in 'a' .. 'z' or CitS(I) = '.' or CitS(I) = '/' then -- valid citation char case State is when IN_CHAPTER => Clast_Index := I; CFound := TRUE; if CitS(I) = '.' then if I > CitS'FIRST then CLast_Index := I-1; State := TO_SECTION; else return ERROR; end if; elsif CitS(I) = '/' then CLast_Index := I-1; State := TO_PARAGRAPH; end if; when TO_SECTION => if CitS(I) not in '0' .. '9' then return ERROR; end if; SFirst_Index := I; SLast_Index := I; State := IN_SECTION; SFound := TRUE; when IN_SECTION => SLast_Index := I; if CitS(I) = '.' then SLast_Index := I-1; State := TO_SUBSECTION; elsif CitS(I) = '/' then SLast_Index := I-1; State := TO_PARAGRAPH; end if; when TO_SUBSECTION => if CitS(I) not in '0' .. '9' then return ERROR; end if; SSFirst_Index := I; SSLast_Index := I; State := IN_SUBSECTION; SSFound := TRUE; when IN_SUBSECTION => SSLast_Index := I; if CitS(I) = '/' then SSLast_Index := I-1; State := TO_PARAGRAPH; end if; when TO_PARAGRAPH => if CitS(I) not in '0' .. '9' then return ERROR; end if; PFirst_Index := I; PLast_Index := I; State := IN_PARAGRAPH; PFound := TRUE; when IN_PARAGRAPH => PLast_Index := I; if CitS(I) not in '0' .. '9' then return ERROR; end if; end case; else -- invalid citation character return ERROR; end if; end loop; Reset_Citation_String; if CFound then Append_to_Citation_String ('C', CitS(CFirst_Index .. CLast_Index)); else return ERROR; end if; if SFound then Append_to_Citation_String ('P', CitS(SFirst_Index .. SLast_Index)); end if; if SSFound then Append_to_Citation_String ('P', CitS(SSFirst_Index .. SSLast_Index)); end if; if PFound then Append_to_Citation_String ('P', CitS(PFirst_Index .. PLast_Index)); end if; return String_to_Citation (Cit_Str(1..Cit_Index)); end Convert_Citation; --------------------------------------------------------------- procedure View_Help is begin -- View_Help Citation_Handler.View_Citation (Citation_Definition.HELP); Dispatch (Citation_Definition.USER_INPUT); end View_Help; --------------------------------------------------------------- procedure Dispatch (Current_Citation : in Citation_Definition.CITATION_ID) is begin -- Dispatch -- Set Citation_to_Process Citation_to_Process := Current_Citation; -- Process Citation_to_Process as a command or a new citation to view while Citation_to_Process /= Citation_Definition.QUIT loop begin case Citation_to_Process is -- all but QUIT (handled by while) and -- PUSH (handled by Process_User_Input) when Citation_Definition.N => Citation_Handler.Next_Screen; Citation_to_Process := Citation_Definition.USER_INPUT; when Citation_Definition.P => Citation_Handler.Previous_Screen; Citation_to_Process := Citation_Definition.USER_INPUT; when Citation_Definition.NEXT => Citation_Handler.Next_Citation; Citation_to_Process := Citation_Definition.USER_INPUT; when Citation_Definition.PREVIOUS => Citation_Handler.Previous_Citation; Citation_to_Process := Citation_Definition.USER_INPUT; when Citation_Definition.POP => Citation_Handler.Pop; Citation_to_Process := Citation_Definition.USER_INPUT; when Citation_Definition.PRINT => Print_Log_Handler.Print_Current_Citation; Citation_to_Process := Citation_Definition.USER_INPUT; when Citation_Definition.PS => Print_Log_Handler.Print_Current_Screen; Citation_to_Process := Citation_Definition.USER_INPUT; when Citation_Definition.PAUSE => delay 5.0; -- seconds Citation_to_Process := Citation_Definition.USER_INPUT; when Citation_Definition.HELP => Citation_Handler.Push (Citation_Definition.HELP); Citation_to_Process := Citation_Definition.USER_INPUT; when Citation_Definition.REFRESH => Citation_Handler.Redisplay_Current_Screen; Citation_to_Process := Citation_Definition.USER_INPUT; when Citation_Definition.USER_INPUT => Process_User_Input; when Citation_Definition.ERROR => Screen_Display_Controller.Show_Error (Screen_Display_Controller.INVALID_COMMAND); Citation_to_Process := Citation_Definition.USER_INPUT; when others => Citation_Handler.View_Citation(Citation_to_Process); Citation_to_Process := Citation_Definition.USER_INPUT; end case; exception when DAF_Handler.FILE_NOT_FOUND => Screen_Display_Controller.Show_Error (Screen_Display_Controller.DAF_NOT_FOUND); Citation_to_Process := Citation_Definition.USER_INPUT; when DAF_Handler.NO_DAF_OPEN => Screen_Display_Controller.Show_Error (Screen_Display_Controller.INTERNAL_DAF_NDFO_ERROR); Citation_to_Process := Citation_Definition.USER_INPUT; when DAF_Handler.READ_ERROR => Screen_Display_Controller.Show_Error (Screen_Display_Controller.INTERNAL_DAF_RE_ERROR); Citation_to_Process := Citation_Definition.USER_INPUT; when DAF_Handler.STACK_OVERFLOW => Screen_Display_Controller.Show_Error (Screen_Display_Controller.INTERNAL_DAF_SO_ERROR); Citation_to_Process := Citation_Definition.USER_INPUT; when DAF_Handler.UNEXPECTED_ERROR => Screen_Display_Controller.Show_Error (Screen_Display_Controller.INTERNAL_DAF_UE_ERROR); Citation_to_Process := Citation_Definition.USER_INPUT; when Primitive_Citation_Handler.SCREEN_COUNT_OVERFLOW => Screen_Display_Controller.Show_Error (Screen_Display_Controller.TOO_MANY_SCREENS); Citation_to_Process := Citation_Definition.USER_INPUT; when Print_Log_Handler.PRINT_LOG_CREATION_ERROR => Screen_Display_Controller.Show_Error (Screen_Display_Controller.PRINT_LOG); Citation_to_Process := Citation_Definition.USER_INPUT; when others => Screen_Display_Controller.Show_Error (Screen_Display_Controller.UNEXPECTED_ERROR); Citation_to_Process := Citation_Definition.USER_INPUT; end; end loop; Console.Position_Cursor (SYSDEP.Error_Message_Line_Number, 1); Console.Erase_Line; end Dispatch; end Command_Dispatcher; --:::::::::: --display.adb --:::::::::: -- *********************************************************************** -- ON-LINE Ada LANGUAGE REFERENCE MANUAL by Richard Conn with Primitive_Citation_Handler; with Unchecked_Conversion; -- standard Ada environment package body Screen_Display_Controller is use DAF_Handler; -- for equality tests Error_Message_Display_Counter : NATURAL := 0; Search_String_Limit : constant := 12; -- max number of chars displayed subtype MSTRING is STRING (1..52); -- based on length of longest message below Messages : constant array (ERROR_MESSAGE_ID) of MSTRING := ( INVALID_COMMAND => "Invalid Command -- Reenter or type HELP for Help ", CANNOT_ADVANCE => "Cannot advance beyond the end of this citation ", CANNOT_BACK => "Cannot back up before the beginning of this citation", STACK_EMPTY => "Location stack is empty ", STACK_FULL => "Location stack is full ", PRINT_LOG => "Print log file error ", TOO_MANY_SCREENS => "Too many screens for internal buffers ", SEARCH_STRING => "Search string not found ", DAF_NOT_FOUND => "DAF Not Found - Aborting ", INTERNAL_DAF_NDFO_ERROR => "Internal DAF Error - No DAF Open ", INTERNAL_DAF_RE_ERROR => "Internal DAF Error - Read Error ", INTERNAL_DAF_SO_ERROR => "Internal DAF Error - Stack Overflow ", INTERNAL_DAF_UE_ERROR => "Internal DAF Error - Unexpected Error ", UNEXPECTED_ERROR => "Unexpected Error -- Continuing " ); --------------------------------------------------------------- -- Support routine procedure Display_Prompt (ID : in STRING; Stack_Size : in NATURAL; Screen_Number : in NATURAL; Number_Screens : in NATURAL; Search_String : in STRING) is -- Display prompt on command line; if Search_String is null, do not -- display it; clear error message if one is present after one call -- to Display_Prompt begin -- Display_Prompt -- Check for clear of error message line if Error_Message_Display_Counter > 0 then Error_Message_Display_Counter := Error_Message_Display_Counter - 1; if Error_Message_Display_Counter = 0 then Console.Position_Cursor (SYSDEP.Error_Message_Line_Number, 1); Console.Erase_Line; end if; end if; -- Display prompt line Console.Position_Cursor (SYSDEP.Command_Line_Number, 1); if (ID'LENGTH = 2) and then ((ID(ID'FIRST) = 'C') and (ID(ID'FIRST+1) in 'A' .. 'F')) then Console.Put ("App " & ID(ID'FIRST+1)); else Console.Put (ID); end if; Console.Put (": "); Console.Put (Stack_Size, 2); Console.Put ("/"); Console.Put (Screen_Number, 3); Console.Put (" of "); Console.Put (Number_Screens, 3); if Search_String'LENGTH > 0 then Console.Put (" (" & '"'); if Search_String'LENGTH > Search_String_Limit then Console.Put (Search_String(Search_String'FIRST .. Search_String'FIRST - 1 +Search_String_Limit) & "..." & '"'); else Console.Put (Search_String & '"'); end if; Console.Put (")"); end if; Console.Put (" -- " & SYSDEP.Program_Name & " Command: "); Console.Erase_Line; end Display_Prompt; --------------------------------------------------------------- procedure Show_Text is -- Clear screen and display the text area Screen : SCREEN_BUFFER_POINTER; begin -- Show_Text -- Clear the screen and home the cursor Console.Erase_Display; Console.Position_Cursor(1,1); -- Get the pointer to the screen Screen := Primitive_Citation_Handler.Access_Screen; -- Display lines in the SBuffer for I in 1 .. Screen.all'LAST loop exit when Screen.all(I).Kind = DAF_Handler.UNUSED; Console.Put_Line (Screen.all(I).Str(1..Screen.all(I).Str_Last)); end loop; end Show_Text; --------------------------------------------------------------- procedure Mark_Line (Number : in LINE_NUMBER) is -- Place the item as a highlighted line on the indicated line number begin -- Mark_Line Console.Position_Cursor (Console.ROW_NUMBER(Number), Console.COLUMN_NUMBER(SYSDEP.Search_Pointer_Column)); Console.Put ("<"); end Mark_Line; --------------------------------------------------------------- procedure Show_Prompt is -- Display prompt on command line; if Search_String is null, do not -- display it; clear error message if one is present after one call -- to Show_Prompt Status : Primitive_Citation_Handler.CITATION_STATISTICS; begin -- Show_Prompt -- Get status information Status := Primitive_Citation_Handler.Current_Citation; -- Display the information Display_Prompt (Citation_to_Display(Status.ID), Status.Stack_Level, Status.Current_Screen_Number, Status.Total_Number_of_Screens, Status.Search_Str(1..Status.Search_Last)); end Show_Prompt; --------------------------------------------------------------- procedure Show_Error (Item : in ERROR_MESSAGE_ID) is -- Display error message begin -- Show_Error Console.Position_Cursor (SYSDEP.Error_Message_Line_Number, 1); Console.Put (Messages(Item)); Error_Message_Display_Counter := 2; end Show_Error; --------------------------------------------------------------- procedure Print_Log_File_Closed_Message is -- Print the message that the indicated print log file is closed begin -- Print_Log_File_Closed_Message Console.Position_Cursor (SYSDEP.Error_Message_Line_Number, 1); Console.Put_Line("Print Log File " & SYSDEP.Print_File_Name & " is Closed"); end Print_Log_File_Closed_Message; --------------------------------------------------------------- function Convert_Ptr is new Unchecked_Conversion (System.ADDRESS, SCREEN_BUFFER_POINTER); function Convert (SB_Address : in System.ADDRESS) return SCREEN_BUFFER_POINTER is -- Given the address of a screen buffer object, return a pointer to it begin -- Convert return Convert_Ptr (SB_Address); end Convert; --------------------------------------------------------------- function Citation_to_Display (CitX : in Citation_Definition.CITATION_ID) return STRING is function Convert (Item : in STRING) return STRING is Result : STRING (1..SYSDEP.Max_String_Length); begin -- Convert if Item'LENGTH >= 2 and then (Item(Item'FIRST) = 'C' and Item(Item'FIRST+1) in '0' .. '9') then for I in Item'FIRST+1 .. Item'LAST loop -- skip first char if Item(I) = 'P' then Result(I-Item'FIRST) := '.'; else Result(I-Item'FIRST) := Item(I); end if; end loop; return Result(1..Item'LENGTH-1); else return Item; end if; end Convert; begin -- Citation_to_Display return Convert (Citation_Definition.CITATION_ID'IMAGE (CitX)); end Citation_to_Display; --------------------------------------------------------------- begin -- initialization section of Screen_Display_Controller Console.Set_Terminal (Console.VT100); end Screen_Display_Controller; --:::::::::: --pcit.adb --:::::::::: -- *********************************************************************** -- ON-LINE Ada LANGUAGE REFERENCE MANUAL by Richard Conn with DAF_Handler; package body Primitive_Citation_Handler is use Citation_Definition; -- for equality and inequality tests infix -- Used to track the first and last line of each screen displayed type SCREEN_BOUNDARIES is record First_Line : NATURAL := 0; Last_Line : NATURAL := 0; end record; -- First and last lines for a maximum number of screens type CITATION_SCREEN_LIST is array (1..SYSDEP.Max_Number_of_Screens) of SCREEN_BOUNDARIES; -- Information pertaining to each citation type CITATION_STATE_INFORMATION is record ID : Citation_Definition.CITATION_ID; Current_Screen : NATURAL := 0; Number_Screens : NATURAL := 0; Screen_List : CITATION_SCREEN_LIST; Search_May_Be_Resumed : BOOLEAN := FALSE; Resume_on_Line : NATURAL; File_ID : DAF_Handler.DAF_ID := 0; end record; -- Stack of information on all citations selected type CITATION_VECTOR is array (1..SYSDEP.Citation_Stack_Depth) of CITATION_STATE_INFORMATION; -- The actual stack of citations Citation_Stack : CITATION_VECTOR; Citation_Index : NATURAL := 1; -- The current citation we are working on Cur_Cit : CITATION_STATE_INFORMATION; -- The actual lines on the current screen -- This is made global to avoid adding routines with excessive -- parameter-passing overhead SBuffer : Screen_Display_Controller.SCREEN_BUFFER; SBuffer_Last : NATURAL; -- Flag used by suspend/resume routines Suspend_Flag : BOOLEAN := FALSE; -- Variables used by search routines Search_Str : SEARCH_STRING; Search_Last : NATURAL := 0; -- Last citation in sequence from CITATION_ID'FIRST up to CONTENTS -- (but not including CONTENTS) Last_Citation_in_Sequence : constant Citation_Definition.CITATION_ID := Citation_Definition.CITATION_ID'PRED(Citation_Definition.CONTENTS); --------------------------------------------------------------- -- Support Subprograms --------------------------------------------------------------- function Is_Blank_Line (Item : in DAF_Handler.LINE) return BOOLEAN is -- Determine if the indicated line is blank Result : BOOLEAN := TRUE; begin -- Is_Blank_Line -- Proceed if line is not empty if Item.Str_Last > 0 then for I in 1 .. Item.Str_Last loop if Item.Str(I) > ' ' then Result := FALSE; exit; end if; end loop; end if; return Result; end Is_Blank_Line; --------------------------------------------------------------- procedure Build_Screen_List is -- pass through the citation, noting line ranges for each screen First_Line : NATURAL := Citation_Definition.CLV(Cur_Cit.ID).Start; Last_Line : NATURAL := Citation_Definition.CLV(Cur_Cit.ID).Stop; Current_Screen : NATURAL := 0; Line_Count : NATURAL := 0; begin -- Build_Screen_List -- Loop through lines of citation, dividing them into screens for I in First_Line .. Last_Line loop Line_Count := Line_Count + 1; if Line_Count = 1 then Current_Screen := Current_Screen + 1; if Current_Screen > SYSDEP.Max_Number_of_Screens then raise SCREEN_COUNT_OVERFLOW; end if; Cur_Cit.Screen_List(Current_Screen).First_Line := I; end if; if Line_Count = SYSDEP.Text_Line_Count then Cur_Cit.Screen_List(Current_Screen).Last_Line := I; Line_Count := 0; end if; end loop; -- If last screen is a partial screen, mark its end if Line_Count > 0 then Cur_Cit.Screen_List(Current_Screen).Last_Line := Last_Line; end if; -- Determine if last screen is blank and remove it from group if so if Current_Screen > 1 then -- Load last screen in citation Cur_Cit.Current_Screen := Current_Screen; Load_Screen_Buffer; -- Check to see if last screen is blank Current_Screen := Current_Screen - 1; -- assume blank for I in 1 .. SBuffer_Last loop if not Is_Blank_Line (SBuffer(I)) then Current_Screen := Current_Screen + 1; exit; end if; end loop; end if; -- Set current screen to 1st screen and set total number of screens Cur_Cit.Current_Screen := 1; Cur_Cit.Number_Screens := Current_Screen; end Build_Screen_List; --------------------------------------------------------------- function OK_to_Advance_to_Next_Citation return BOOLEAN is begin -- OK_to_Advance_to_Next_Citation return (Cur_Cit.ID >= Citation_Definition.CITATION_ID'FIRST) and (Cur_Cit.ID < Last_Citation_in_Sequence); end OK_to_Advance_to_Next_Citation; --------------------------------------------------------------- function OK_to_Back_to_Previous_Citation return BOOLEAN is begin -- OK_to_Back_to_Previous_Citation return (Cur_Cit.ID > Citation_Definition.CITATION_ID'FIRST) and (Cur_Cit.ID <= Last_Citation_in_Sequence); end OK_to_Back_to_Previous_Citation; --------------------------------------------------------------- function Scan_for_String (SB_Index : in NATURAL) return BOOLEAN is -- scan SBuffer line for string in Search_Str, return TRUE if found Result : BOOLEAN := FALSE; function Is_Equal (Item1, Item2 : in STRING) return BOOLEAN is -- Determine if two strings are equal (case insensitive) Result : BOOLEAN := TRUE; function To_Lower (Item : in CHARACTER) return CHARACTER is begin -- To_Lower if Item in 'A' .. 'Z' then return CHARACTER'VAL(CHARACTER'POS(Item) - CHARACTER'POS('A') + CHARACTER'POS('a')); else return Item; end if; end To_Lower; begin -- Is_Equal for I in Item1'RANGE loop if To_Lower(Item1(I)) /= To_Lower(Item2(Item2'FIRST + I - Item1'FIRST)) then Result := FALSE; exit; end if; end loop; return Result; end Is_Equal; begin -- Scan_for_String -- If the line in the SBuffer is as large as the target string, -- then proceed, else fail search immediately if Search_Last <= SBuffer(SB_Index).Str_Last then -- Check substrings starting at first character in SBuffer for I in 1 .. SBuffer(SB_Index).Str_Last-Search_Last + 1 loop if Is_Equal (SBuffer(SB_Index).Str(I .. I + Search_Last - 1), Search_Str(1..Search_Last)) then Result := TRUE; exit; end if; end loop; end if; return Result; end Scan_for_String; --------------------------------------------------------------- function Linear_Search (Start_Screen : in NATURAL; Start_Line : in NATURAL) return SEARCH_STATUS is -- Search forward from Search_Line to the end of the citation Start : NATURAL := Start_Line; Dummy : BOOLEAN := TRUE; Result : SEARCH_STATUS := (FALSE, 0, 0); Saved_Status : SEARCH_STATUS := (Cur_Cit.Search_May_Be_Resumed, Cur_Cit.Current_Screen, Cur_Cit.Resume_on_Line); begin -- Linear_Search search_loop: for S in Start_Screen..Cur_Cit.Number_Screens loop Cur_Cit.Current_Screen := S; Load_Screen_Buffer; for L in Start .. SBuffer'Last loop if Scan_For_String(L) then Result.Is_Found := TRUE; Result.Found_on_Screen := S; Result.Found_on_Line := L; exit search_loop; end if; end loop; Start := 1; if S < Cur_Cit.Number_Screens then Dummy := Next_Screen; end if; end loop search_loop; if Result.Is_Found then Cur_Cit.Resume_on_Line := Result.Found_on_Line; Cur_Cit.Search_May_Be_Resumed := TRUE; else Cur_Cit.Current_Screen := Saved_Status.Found_on_Screen; Load_Screen_Buffer; Cur_Cit.Resume_on_Line := Saved_Status.Found_on_Line; Cur_Cit.Search_May_Be_Resumed := Saved_Status.Is_Found; end if; return Result; end Linear_Search; --------------------------------------------------------------- -- Exported Subprograms --------------------------------------------------------------- function DAF_File_Name (ITEM : in Citation_Definition.CITATION_ID) return STRING is begin -- DAF_File_Name if Citation_Definition.CLV(Item).Chapter(1) = ' ' then return ""; else return SYSDEP.LRM_Files_Directory & "chap" & Citation_Definition.CLV(Item).Chapter & ".daf"; end if; end DAF_File_Name; ----------------------------------------------------------------------- procedure Open_New_Citation (ID : in Citation_Definition.CITATION_ID) is -- Open a new citation for processing, closing the old one if -- necessary; set the current screen to the first screen; -- build an array of information on the screens begin -- Open_New_Citation -- Check to see if a DAF file is open and close it if so if Cur_Cit.File_ID > 0 and then DAF_Handler.Is_Open (Cur_Cit.File_ID) then DAF_Handler.Close (Cur_Cit.File_ID); end if; -- Set the ID of the current citation to the new citation Cur_Cit.ID := ID; -- Open the new DAF file Cur_Cit.File_ID := DAF_Handler.Open (DAF_File_Name (ID)); -- Build the screen list since we have entered a new citation Build_Screen_List; -- Reset search variable since we have moved screens Cur_Cit.Search_May_Be_Resumed := FALSE; -- Update the current citation stack entry Citation_Stack(Citation_Index) := Cur_Cit; end Open_New_Citation; --------------------------------------------------------------- function Push return BOOLEAN is -- Push the stack, returning TRUE if OK begin -- Push if Citation_Index < SYSDEP.Citation_Stack_Depth then Citation_Stack(Citation_Index) := Cur_Cit; Cur_Cit.File_ID := 0; Citation_Index := Citation_Index + 1; return TRUE; else return FALSE; end if; end Push; --------------------------------------------------------------- function Pop return BOOLEAN is -- Pop the stack, returning TRUE if OK -- Cur_Cit is loaded appropriately begin -- Pop if Citation_Index > 1 then -- Check to see if a DAF file is open and close it if so if DAF_Handler.Is_Open (Cur_Cit.File_ID) then DAF_Handler.Close (Cur_Cit.File_ID); end if; -- Back up on stack Citation_Index := Citation_Index - 1; Cur_Cit := Citation_Stack(Citation_Index); return TRUE; else return FALSE; end if; end Pop; --------------------------------------------------------------- procedure Load_Screen_Buffer is -- Load the screen buffer with the current screen Start_Line : NATURAL; Stop_Line : NATURAL; begin -- Load_Screen_Buffer -- Set line numbers of first and last lines to load Start_Line := Cur_Cit.Screen_List(Cur_Cit.Current_Screen).First_Line; Stop_Line := Cur_Cit.Screen_List(Cur_Cit.Current_Screen).Last_Line; -- Read first line via direct access SBuffer(1) := DAF_Handler.Read (Cur_Cit.File_ID, Start_Line); SBuffer_Last := 1; -- Read in rest of lines sequentially for I in Start_Line+1 .. Stop_Line loop SBuffer_Last := SBuffer_Last + 1; SBuffer(SBuffer_Last) := DAF_Handler.Read_Next (Cur_Cit.File_ID); end loop; -- If any lines left, mark them unused if SBuffer_Last < SBuffer'LAST then for I in SBuffer_Last+1 .. SBuffer'LAST loop SBuffer(I).Kind := DAF_Handler.UNUSED; end loop; end if; -- Set search flag to indicate that continuation of search -- from the Resume_on_Line is not possible since the SBuffer -- has been reloaded Cur_Cit.Search_May_Be_Resumed := FALSE; end Load_Screen_Buffer; --------------------------------------------------------------- function Next_Screen return BOOLEAN is -- Advance to the next screen, returning TRUE if done; -- if at last screen of current citation, advance to the first screen -- of the next citation -- Screen Buffer is loaded appropriately Result : BOOLEAN := FALSE; begin -- Next_Screen -- Advance to next screen if we have not reached the -- total number of screens; if we advanced, reload the -- SBuffer if Cur_Cit.Current_Screen < Cur_Cit.Number_Screens then Cur_Cit.Current_Screen := Cur_Cit.Current_Screen + 1; Load_Screen_Buffer; return TRUE; else return Next_Citation; end if; end Next_Screen; --------------------------------------------------------------- function Previous_Screen return BOOLEAN is -- Back up to the previous screen, returning TRUE if done; -- if at first screen of current citation, back up to last screen -- of previous citation -- Screen Buffer is loaded appropriately begin -- Previous_Screen if Cur_Cit.Current_Screen > 1 then Cur_Cit.Current_Screen := Cur_Cit.Current_Screen - 1; Load_Screen_Buffer; return TRUE; elsif OK_To_Back_To_Previous_Citation then Open_New_Citation (Citation_Definition.CITATION_ID'PRED(Cur_Cit.ID)); Cur_Cit.Current_Screen := Cur_Cit.Number_Screens; Load_Screen_Buffer; return TRUE; else return FALSE; end if; end Previous_Screen; --------------------------------------------------------------- function Next_Citation return BOOLEAN is -- Advance to the first screen of the next citation, return TRUE if done -- Screen Buffer is loaded appropriately begin -- Next_Citation if OK_to_Advance_to_Next_Citation then Open_New_Citation(Citation_Definition.CITATION_ID'SUCC(Cur_Cit.ID)); Load_Screen_Buffer; return TRUE; else return FALSE; end if; end Next_Citation; --------------------------------------------------------------- function Previous_Citation return BOOLEAN is -- Back up to the first screen of the previous citation, return TRUE -- if done -- Screen Buffer is loaded appropriately begin -- Previous_Citation if OK_to_Back_to_Previous_Citation then Open_New_Citation(Citation_Definition.CITATION_ID'PRED(Cur_Cit.ID)); Load_Screen_Buffer; return TRUE; else return FALSE; end if; end Previous_Citation; --------------------------------------------------------------- function Search_First (Item : in STRING) return SEARCH_STATUS is -- Search for the Item from the beginning of the citation; -- if Item is an empty string, resume search for last item requested Result : SEARCH_STATUS; begin -- Search_First if Item'LENGTH > 0 then Search_Str(1..Item'LENGTH) := Item; Search_Last := Item'LENGTH; end if; Result := Linear_Search (Cur_Cit.Current_Screen, 1); if Result.Is_Found then Cur_Cit.Search_May_Be_Resumed := TRUE; Cur_Cit.Resume_on_Line := Result.Found_on_Line; end if; return Result; end Search_First; --------------------------------------------------------------- function Search_Next (Item : in STRING) return SEARCH_STATUS is -- Resume search for Item from the next line in the citation; -- if Item is an empty string, resume search for last item requested Result : SEARCH_STATUS; Start : NATURAL; begin -- Search_Next if Item'LENGTH > 0 then Search_Str(1..Item'LENGTH) := Item; Search_Last := Item'LENGTH; end if; if Cur_Cit.Search_May_Be_Resumed then Start := Cur_Cit.Resume_on_Line+1; else Start := 1; end if; Result := Linear_Search (Cur_Cit.Current_Screen, Start); if Result.Is_Found then Cur_Cit.Search_May_Be_Resumed := TRUE; Cur_Cit.Resume_on_Line := Result.Found_on_Line; end if; return Result; end Search_Next; --------------------------------------------------------------- function Current_Citation return CITATION_STATISTICS is -- Return the statistics on the current citation begin -- Current_Citation return CITATION_STATISTICS' (ID => Cur_Cit.ID, Current_Screen_Number => Cur_Cit.Current_Screen, Total_Number_of_Screens => Cur_Cit.Number_Screens, Stack_Level => Citation_Index, Search_Str => Search_Str, Search_Last => Search_Last, Search_May_Be_Continued => Cur_Cit.Search_May_Be_Resumed); end Current_Citation; --------------------------------------------------------------- procedure Close_All_Open_Citations is -- Close all open citation files begin -- Close_All_Open_Citations for I in 1..Citation_Index loop DAF_Handler.Close (Citation_Stack(I).File_ID); end loop; end Close_All_Open_Citations; --------------------------------------------------------------- procedure Suspend is -- Suspend operation for Print_Log_Handler begin -- Suspend if not Suspend_Flag then if Cur_Cit.File_ID > 0 and then DAF_Handler.Is_Open (Cur_Cit.File_ID) then DAF_Handler.Close (Cur_Cit.File_ID); end if; Suspend_Flag := TRUE; end if; end Suspend; --------------------------------------------------------------- procedure Resume is -- Resume operation for Print_Log_Handler begin -- Resume if Suspend_Flag then Cur_Cit.File_ID := DAF_Handler.Open (DAF_File_Name (Cur_Cit.ID)); Load_Screen_Buffer; Suspend_Flag := FALSE; end if; end Resume; --------------------------------------------------------------- function Access_Screen return Screen_Display_Controller.SCREEN_BUFFER_POINTER is -- Return the address of the screen for printing or displaying begin -- Access_Screen return Screen_Display_Controller.Convert (SBuffer'ADDRESS); end Access_Screen; end Primitive_Citation_Handler; --:::::::::: --cith2.adb --:::::::::: -- *********************************************************************** -- ON-LINE Ada LANGUAGE REFERENCE MANUAL by Richard Conn with Primitive_Citation_Handler; with Screen_Display_Controller; package body Citation_Handler is --------------------------------------------------------------- -- Exported Subprograms --------------------------------------------------------------- procedure View_Citation (New_Citation : in Citation_Definition.CITATION_ID) is -- Start viewing a new citation, displaying the first screen begin -- View_Citation Primitive_Citation_Handler.Open_New_Citation (New_Citation); Primitive_Citation_Handler.Load_Screen_Buffer; Redisplay_Current_Screen; end View_Citation; --------------------------------------------------------------- procedure Redisplay_Current_Screen is -- Refresh current screen in current citation begin -- Redisplay_Current_Screen Screen_Display_Controller.Show_Text; end Redisplay_Current_Screen; --------------------------------------------------------------- procedure Next_Screen is -- Advance to next screen in current citation and display dummy : BOOLEAN; begin -- Next_Screen if Primitive_Citation_Handler.Next_Screen then Redisplay_Current_Screen; else Screen_Display_Controller.Show_Error (Screen_Display_Controller.CANNOT_ADVANCE); end if; end Next_Screen; --------------------------------------------------------------- procedure Previous_Screen is -- Back up to previous screen in current citation and display begin -- Previous_Screen if Primitive_Citation_Handler.Previous_Screen then Redisplay_Current_Screen; else Screen_Display_Controller.Show_Error (Screen_Display_Controller.CANNOT_BACK); end if; end Previous_Screen; --------------------------------------------------------------- procedure Next_Citation is -- Close current citation and view first screen of next citation begin -- Next_Citation if Primitive_Citation_Handler.Next_Citation then Redisplay_Current_Screen; else Screen_Display_Controller.Show_Error (Screen_Display_Controller.CANNOT_ADVANCE); end if; end Next_Citation; --------------------------------------------------------------- procedure Previous_Citation is -- Close current citation and view first screen of previous citation begin -- Previous_Citation if Primitive_Citation_Handler.Previous_Citation then Redisplay_Current_Screen; else Screen_Display_Controller.Show_Error (Screen_Display_Controller.CANNOT_BACK); end if; end Previous_Citation; --------------------------------------------------------------- procedure Push (New_Citation : in Citation_Definition.CITATION_ID) is -- Save position in current citation and -- start viewing a new citation, displaying the first screen begin -- Push if Primitive_Citation_Handler.Push then Primitive_Citation_Handler.Open_New_Citation (New_Citation); Primitive_Citation_Handler.Load_Screen_Buffer; Redisplay_Current_Screen; else Screen_Display_Controller.Show_Error (Screen_Display_Controller.STACK_FULL); end if; end Push; --------------------------------------------------------------- procedure Pop is -- Return to current position in last citation before last PUSH begin -- Pop if Primitive_Citation_Handler.Pop then Primitive_Citation_Handler.Load_Screen_Buffer; Redisplay_Current_Screen; else Screen_Display_Controller.Show_Error (Screen_Display_Controller.STACK_EMPTY); end if; end Pop; --------------------------------------------------------------- procedure Search_for_First_Occurrence (Item : in STRING) is -- Search for first occurrence of string in current citation Result : Primitive_Citation_Handler.SEARCH_STATUS; begin -- Search_for_First_Occurrence Result := Primitive_Citation_Handler.Search_First(Item); Redisplay_Current_Screen; if Result.Is_Found then Screen_Display_Controller.Mark_Line (Result.Found_on_Line); else Screen_Display_Controller.Show_Error (Screen_Display_Controller.SEARCH_STRING); end if; end Search_for_First_Occurrence; --------------------------------------------------------------- procedure Search_for_Next_Occurrence (Item : in STRING) is -- Search for next occurrence of string in current citation Result : Primitive_Citation_Handler.SEARCH_STATUS; begin -- Search_for_First_Occurrence Result := Primitive_Citation_Handler.Search_Next(Item); Redisplay_Current_Screen; if Result.Is_Found then Screen_Display_Controller.Mark_Line (Result.Found_on_Line); else Screen_Display_Controller.Show_Error (Screen_Display_Controller.SEARCH_STRING); end if; end Search_for_Next_Occurrence; --------------------------------------------------------------- procedure Close_All_Open_Citations is -- Close all open citations begin -- Close Primitive_Citation_Handler.Close_All_Open_Citations; end Close_All_Open_Citations; end Citation_Handler; --:::::::::: --printlog.adb --:::::::::: -- *********************************************************************** -- ON-LINE Ada LANGUAGE REFERENCE MANUAL by Richard Conn with SYSDEP; with Citation_Definition; with DAF_Handler; with Primitive_Citation_Handler; with Screen_Display_Controller; with Output_File; -- CS Parts package body Print_Log_Handler is use DAF_Handler; -- for equality test Output_File_ID : Output_File.FILE_TYPE; Is_Open : BOOLEAN := FALSE; --------------------------------------------------------------- procedure Print_Banner is Current_Stats : Primitive_Citation_Handler.CITATION_STATISTICS; begin -- Print_Banner -- Open output file if needed if not Is_Open then Output_File.Create (Output_File_ID, SYSDEP.Print_File_Name); Is_Open := TRUE; end if; Current_Stats := Primitive_Citation_Handler.Current_Citation; Output_File.Put_Line (Output_File_ID, "----------------------------------------------------"); Output_File.Put_Line (Output_File_ID, "-- Citation: " & Screen_Display_Controller.Citation_to_Display (Current_Stats.ID)); end Print_Banner; --------------------------------------------------------------- procedure Print_Current_Citation is Current_Stats : Primitive_Citation_Handler.CITATION_STATISTICS; Input_File : DAF_Handler.DAF_ID; Inline : DAF_Handler.LINE; begin -- Print_Current_Citation -- Print banner Print_Banner; -- Copy citation section to output file Current_Stats := Primitive_Citation_Handler.Current_Citation; if Primitive_Citation_Handler.DAF_File_Name(Current_Stats.ID)'LENGTH > 0 then Primitive_Citation_Handler.Suspend; begin Input_File := DAF_Handler.Open (Primitive_Citation_Handler.DAF_File_Name(Current_Stats.ID)); Inline := DAF_Handler.Read (Input_File, Citation_Definition.CLV(Current_Stats.ID).Start); Output_File.Put_Line (Output_File_ID, Inline.Str(1..Inline.Str_Last)); for I in Citation_Definition.CLV(Current_Stats.ID).Start+1 .. Citation_Definition.CLV(Current_Stats.ID).Stop loop Inline := DAF_Handler.Read_Next (Input_File); Output_File.Put_Line (Output_File_ID, Inline.Str(1..Inline.Str_Last)); end loop; exception when others => null; -- assume EOF end; DAF_Handler.Close (Input_File); Primitive_Citation_Handler.Resume; end if; exception -- Print_Current_Citation when others => raise PRINT_LOG_CREATION_ERROR; end Print_Current_Citation; --------------------------------------------------------------- procedure Print_Current_Screen is -- Print indicated screen to log file Screen : Screen_Display_Controller.SCREEN_BUFFER_POINTER; Current_Stats : Primitive_Citation_Handler.CITATION_STATISTICS; begin -- Print_Current_Screen -- Print banner Current_Stats := Primitive_Citation_Handler.Current_Citation; Print_Banner; Screen := Primitive_Citation_Handler.Access_Screen; Output_File.Put_Line (Output_File_ID, "-- Screen Number:" & NATURAL'IMAGE(Current_Stats.Current_Screen_Number)); -- Output lines of screen for I in 1 .. Screen.all'LAST loop exit when Screen.all(I).Kind = DAF_Handler.UNUSED; Output_File.Put_Line (Output_File_ID, Screen.all(I).Str(1..Screen.all(I).Str_Last)); end loop; exception when others => raise PRINT_LOG_CREATION_ERROR; end Print_Current_Screen; --------------------------------------------------------------- procedure Close_Print_Log is begin -- Close_Print_Log if Is_Open then Output_File.Close (Output_File_ID); Screen_Display_Controller.Print_Log_File_Closed_Message; end if; end Close_Print_Log; end Print_Log_Handler;